home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir37
/
mxmnu241.zip
/
NAVYTIME.MNU
< prev
next >
Wrap
Text File
|
1992-12-14
|
2KB
|
123 lines
Comment
==========================================================
Copyright 1992 by Marc Perkel * All right reserved.
This program is used to call the Navy atomic clock and set all
your file servers to the correct time.
=========================================================
EndComment
var
CheckCarrierDetect
NumberToDial
TimeOffset
StandardIO
;----- Set com port, number, and time offfset to match your system.
ComPort = Com2
NumberToDial = 'ATTD 9,1-202-653-0351'
TimeOffSet = 6 ;Central Standard Time
ComInitPort(1200,8,'N',1) ;1200 baud access only
CheckCarrierDetect = not ComCD
Writeln
Writeln '==> Calling Naval Atomic Clock'
Writeln
CallClock
SetTime(GetTimeString)
ExitMenu
;----- Procedures
Procedure SetTime (St)
var H Servers Serv T
St = Mid(St,11,6)
H = Value(Mid(St,1,2)) + 24 - TimeOffset mod 24
St = Str(H) + ':' + Mid(St,3,2) + ':' + Right(St,2)
T = TimeOf(St) + 1
Writeln 'Setting Time to: ==> ' DateString(T) ' ' TimeString(T)
NovAttachedServers(Servers)
Writeln
Loop Servers
Serv = Servers[LoopIndex]
Write 'Setting Server ' Serv ' Clock ... '
NovSetPreferredServer Serv
NovServerTime = T
Writeln
EndLoop
Now = T
ExitMenu
EndProc
Procedure GetTimeString
ComWatchCD
while True
CharLoop
if length(ComLastLine) = 20 then Return ComLastLine
endwhile
EndProc
Procedure TestAbort
var Ch
if ComCDAbort
Writeln '[Carrier Dropped]'
ExitMenu
endif
if not KbdReady then Return
Ch = ReadKey
if Ch = ESC then ExitMenu
EndProc
Procedure CharLoop
TestAbort
if ComCharReady
Write ComReadChar
endif
EndProc
Procedure WaitFor (St)
while ComLastLine <> St
CharLoop
endwhile
EndProc
Procedure CallClock
ComWrite 'ATZ' CR
WaitFor ('OK')
Wait 20
ComWriteln NumberToDial CR
while True
CharLoop
if pos('CONNECT',ComLastLine) > 0
Wait 100
Return
elseif ComLastLine = 'BUSY'
ExitMenu
elseif ComLastLine = 'NO DIALTONE'
ExitMenu
elseif ComLastLine = 'NO CARRIER'
ExitMenu
endif
endwhile
EndProc